home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
sftgrd
/
2_groups.frm
< prev
next >
Wrap
Text File
|
1996-06-12
|
7KB
|
292 lines
VERSION 2.00
Begin Form fmtTwoGroups
BorderStyle = 1 'Fixed Single
Caption = "Two Groups"
ClientHeight = 5820
ClientLeft = 1095
ClientTop = 1485
ClientWidth = 7365
Height = 6225
Left = 1035
LinkTopic = "Form7"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5820
ScaleWidth = 7365
Top = 1140
Width = 7485
Begin CommandButton cmdCancel
Cancel = -1 'True
Caption = "Cancel"
Default = -1 'True
Height = 495
Left = 3120
TabIndex = 7
Top = 4800
Width = 1215
End
Begin CommandButton cmdOK
Caption = "OK"
Height = 495
Left = 3120
TabIndex = 6
Top = 4080
Width = 1215
End
Begin CommandButton cmdRemoveAll
Caption = "Remove All"
Height = 495
Left = 3120
TabIndex = 4
Top = 2760
Width = 1215
End
Begin CommandButton cmdRemove
Caption = "<== Remove"
Height = 495
Left = 3120
TabIndex = 3
Top = 1800
Width = 1215
End
Begin CommandButton cmdAdd
Caption = "Add ==>"
Height = 495
Left = 3120
TabIndex = 2
Top = 840
Width = 1215
End
Begin ListBox lstRight
Height = 4905
Left = 4800
MultiSelect = 2 'Extended
TabIndex = 1
Top = 600
Width = 2295
End
Begin ListBox lstLeft
Height = 4905
Left = 360
MultiSelect = 2 'Extended
Sorted = -1 'True
TabIndex = 0
Top = 600
Width = 2295
End
Begin Label lblRight
Alignment = 2 'Center
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "lblRight"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = -1 'True
Height = 375
Left = 4800
TabIndex = 9
Top = 240
Width = 2295
End
Begin Label lblLeft
Alignment = 2 'Center
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "lblLeft"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = -1 'True
Height = 375
Left = 360
TabIndex = 8
Top = 240
Width = 2295
End
Begin Label lblExitStatus
Caption = "ExitStatus"
Height = 495
Left = 3120
TabIndex = 5
Top = 5280
Visible = 0 'False
Width = 1215
End
End
': 2_GROUPS.FRM
'- Manage what is in two groups
'
' Copyright 1994, AA-Software International
' Distributed for non-commercial educational use only.
' For other use contact:
' AA-Software International
' 12 ter Domaine Du Bois Joli
' 06330 Roquefort-Les-Pins, France
'
' Tel: (+33) 93.77.50.47
' Fax: (+33) 93.77.19.78
' Internet: cswilly@acm.org
' CompuServe: 100343,2570
'
Option Explicit
Sub cmdAdd_Click ()
pAddToRight
End Sub
Sub cmdCancel_Click ()
lblExitStatus.Caption = "CANCEL"
Me.Hide
End Sub
Sub cmdOK_Click ()
lblExitStatus.Caption = "OK"
Me.Hide
End Sub
Sub cmdRemove_Click ()
pAddToLeft
End Sub
Sub cmdRemoveAll_Click ()
Dim itemKtr_i As Integer
'Move all items from Right group to Left group
For itemKtr_i = 0 To lstRight.ListCount - 1
lstLeft.AddItem lstRight.List(itemKtr_i)
Next itemKtr_i
'Remove All Groups from In-favor list
lstRight.Clear
pSetRemoveAllButton
pSetFocus lstRight, lstLeft
End Sub
Sub Form_Activate ()
pSetRemoveAllButton
pSetFocus lstLeft, lstRight
End Sub
Sub Form_Load ()
cmdAdd.Enabled = False
cmdRemove.Enabled = False
End Sub
Sub lstLeft_Click ()
cmdAdd.Enabled = True
cmdRemove.Enabled = False
End Sub
Sub lstLeft_DblClick ()
pAddToRight
End Sub
Sub lstRight_Click ()
cmdAdd.Enabled = False
cmdRemove.Enabled = True
End Sub
Sub lstRight_DblClick ()
pAddToLeft
End Sub
Private Sub pAddToLeft ()
pMoveItem lstRight, lstLeft
End Sub
Private Sub pAddToRight ()
pMoveItem lstLeft, lstRight
End Sub
Private Sub pMoveItem (lstFrom As Control, lstTo As Control)
Dim insertPoint_i As Integer
insertPoint_i = lstTo.ListIndex + 1
If insertPoint_i > lstTo.ListCount Then insertPoint_i = lstTo.ListCount
Dim itemKtr_i As Integer
'Copy from lstFrom to lstTo
For itemKtr_i = 0 To lstFrom.ListCount - 1
If lstFrom.Selected(itemKtr_i) Then
lstTo.AddItem lstFrom.List(itemKtr_i), insertPoint_i
insertPoint_i = insertPoint_i + 1
End If
Next itemKtr_i
'Remove from lstFrom
itemKtr_i = 0
Do While itemKtr_i < lstFrom.ListCount
If lstFrom.Selected(itemKtr_i) Then
lstFrom.RemoveItem (itemKtr_i)
Else
itemKtr_i = itemKtr_i + 1
End If
Loop
lstTo.Selected(lstTo.ListIndex) = False
lstTo.ListIndex = insertPoint_i - 1
lstTo.Selected(lstTo.ListIndex) = True
pSetRemoveAllButton
pSetFocus lstFrom, lstTo
End Sub
Private Sub pSetFocus (c1 As Control, c2 As Control)
If c1.ListCount = 0 Then
'clear select flag
Dim listKtr_i As Integer
For listKtr_i = 0 To c2.ListCount - 1
c2.Selected(listKtr_i) = False
Next listKtr_i
'Select first item
c2.ListIndex = 0
c2.Selected(c2.ListIndex) = True
c2.SetFocus
Exit Sub
End If
If c1.ListIndex >= 0 Then
'Select the current items
c1.Selected(c1.ListIndex) = True
Else
'Must have fallen off the end of the list Select the last items
c1.ListIndex = c1.ListCount - 1
c1.Selected(c1.ListIndex) = True
End If
c1.SetFocus
End Sub
Private Sub pSetRemoveAllButton ()
If lstRight.ListCount > 1 Then
cmdRemoveAll.Enabled = True
Else
cmdRemoveAll.Enabled = False
End If
End Sub